home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 46 / Amiga Format CD46 (1999-10-20)(Future Publishing)(GB)[!][issue 1999-12].iso / -in_the_mag- / reader_requests / scilab / maple / maple2scilab.maple next >
Text File  |  1999-09-16  |  4KB  |  128 lines
  1. maple2scilab:=proc(macroname,expr,arguments)
  2. # Converts a maple matrix function into a scilab macro.
  3. # The maple matrix is a function of arguments as well as
  4. # the scilab macro.
  5. # rpath, global Maple variable is the pathname for the
  6. # source code of the scilab function and fortran routine
  7. # 
  8. local fname,sname,maplematrix,outputsize,lpath:
  9. if type(expr,scalar) then 
  10.  maplematrix:=vector([expr]):
  11.  maplematrix:=convert(maplematrix,matrix):
  12. else:
  13.  maplematrix:=convert(expr,matrix):
  14. fi:
  15. if substring(rpath,1..5) = `rpath` then lpath:=``:else:lpath:=rpath:fi:
  16. fname:=cat(``.lpath,macroname,`.f`):
  17. sname:=cat(``.lpath,macroname,`.sci`):
  18. outputsize:=[rowdim(maplematrix),coldim(maplematrix)]:
  19. print(`Write files <`.sname.`>`):
  20. print(`and <`. fname. `>`):
  21. make_fortran(fname,macroname,maplematrix,arguments):
  22. make_scilab(sname,macroname,macroname,arguments,outputsize):
  23. end:
  24.  
  25.  
  26. make_fortran:=proc(filename,routinename,maplematrix,arguments)
  27. #
  28. #This procedure converts the maple matrix ``maplematrix'' into a fortran 
  29. #subroutine.
  30. #The fortran calling sequence is routinename(x1,x2,...,xn,matrix)
  31. #and the subroutine computes matrix(i,j) as a function of
  32. #the arguments x1,x2,...,xn.
  33. #Each argument can be a maple scalar or array which should be
  34. #in the list ``arguments''.
  35. #The subroutine is put into a file named filename (character string).
  36. #
  37. global optimized:
  38. local flist,matr,listarg,m,k:
  39. #Maple V Release 2
  40. if interface(version)=`SCG2`     then 
  41.   read ``.libname.`/macrofor.m`:
  42. #Maple V Release 3
  43. elif not(assigned(macrofor)) and 
  44.    substring(interface(version),18..18) =`3` then
  45.    with(share):readshare(macrofor,numerics):
  46. fi:
  47. init_genfor():
  48. matr:=convert(maplematrix,matrix):
  49. listarg:=[]:
  50. for k in arguments do
  51.   if type(op(k),vector) 
  52.    then listarg:=[op(listarg),k[rowdim(convert(k,matrix))]];
  53.    elif type(op(k),matrix) 
  54.     then listarg:=[op(listarg),k[rowdim(convert(k,matrix)),
  55.                                  coldim(convert(k,matrix))]];
  56.    else listarg:=[op(listarg),k];
  57.   fi;
  58. od;
  59. flist:=[subroutinem,routinename,[op(arguments),fmat],
  60.            [
  61.             [ declaref,`implicit doubleprecision`,[`(t)`] ],
  62.             [ declaref,doubleprecision,listarg ],
  63.             [ declaref,doubleprecision,[fmat[rowdim(matr),coldim(matr)]] ],
  64.             [ matrixm,fmat,matr ] 
  65.            ]
  66.         ]:
  67. optimized:=true:
  68. writeto(filename):
  69. genfor(flist):
  70. writeto(terminal):
  71. end:
  72.  
  73.  
  74. make_scilab:=proc(filename,macroname,routinename,arguments,outputsize)
  75. # This procedure generates the scilab macro which calls
  76. # the fortran subroutine ``routinename''.
  77. #
  78. local k,kk,l1,l2,ff,first0,ss,snd0,thrd,forth,rest,chain,i,nargs:
  79. #
  80. ff:=cat(`(`,arguments[1]):
  81. k:=2:
  82. nargs:=nops(arguments):
  83. while k < nargs+1 do ff:=cat(ff,`,`,arguments[k]):k:=k+1:od:
  84. ff:=cat(ff,`)`):
  85. ff:=cat(`function [var]=`,macroname,ff):
  86. l1:=0:
  87. rest:=first:
  88. if length(ff) > 70 then 
  89.  while length(rest) > 70 do
  90.   first.l1:=cat(substring(rest,1..70),`...`):
  91.   l1:=l1+1:
  92.   first.l1:=substring(rest,71..length(rest)):
  93.   rest:=first.l1:
  94.  od:
  95.  else
  96.  first.0:=ff:
  97. fi:
  98. #
  99. ss:=cat(`var=fort(`,`'`,routinename,`',`):
  100. i:=1:
  101. for kk in arguments do chain:=cat(kk,`,`,i,`,`,`'d',`):
  102.   ss:=cat(ss,chain):
  103.   i:=i+1:
  104. od:
  105. ss:=cat(ss,`'out',`):
  106. ss:=cat(ss,`[`,outputsize[1],`,`,outputsize[2],`],`,nargs+1,`,'d')`):
  107. l2:=0:
  108. rest:=ss:
  109. if length(ss) > 70 then 
  110.  while length(rest) > 70 do
  111.   snd.l2:=cat(substring(rest,1..70),`...`):
  112.   l2:=l2+1:
  113.   snd.l2:=substring(rest,71..length(rest)):
  114.   rest:=snd.l2:
  115.  od:
  116.  else
  117.  snd.0:=ss:
  118. fi:
  119. writeto(filename):
  120. for i from 0 to l1 do lprint(``.first.i):od:
  121. for i from 0 to l2 do lprint(``.snd.i):od:
  122. lprint(`//end`):
  123. writeto(terminal):
  124. #
  125. end:
  126.  
  127.  
  128.